Análisis Demográfico 1
Dr. Víctor Manuel García Guerrero
vmgarcia@colmex.mx
Data
Cargamos la base de datos Data es su forma “cruda”
Nota
Sientase libre de jugar con la tabla de valores. Note que hay renglones y casillas en blanco que corresponden a valores no especificados, NA. Note también que hay casillas del tipo De 5 a 9 años. Nuestra labor será limpiar o eliminar estos renglones y casillas.
Data
Ahora, asignemos nombres a las columnas de nuestra tabla de datos.
Data
Filtremos los renglones de la tabla de datos Data, manteniendo solo aquellos de la columna edo que no tienen valores NA y asignemos esta tabla filtrada a una nueva tabla de datos base_mx
Data
Seleccionemos todas las columnas, excepto id y both
Data
Despues de aplicar na.omit() a base_mx, solo nos quedaremos con los renglones donde no hay valores NA.
Nota
En la tabla, busque valores donde la variable age tome el valor “Total”
Data
En este segundo filter() estamos eliminando los renglones donde:
el valor age es Total
la columna age contiene la palabra De
la columna age contiene la palabra 85 años
library(tidyverse)
library(stringr)
library(DT)
load("R/data.RData")
names(data)<-
c("id","edo","age","both","males","females")
base_mx <- data %>%
filter(is.na(edo) == FALSE) %>%
select(-c("id", "both")) %>%
na.omit() %>%
filter(
age != "Total",
!grepl("De", age),
!grepl("85 años", age)
)
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))Data
La función mutate es usada para modificar una columna existente o agregar una nueva. En nuestro caso, modificaremos nuestra columna age para extraer el valor numérico de todos los renglones.
library(tidyverse)
library(stringr)
library(DT)
load("R/data.RData")
names(data)<-
c("id","edo","age","both","males","females")
base_mx <- data %>%
filter(is.na(edo) == FALSE) %>%
select(-c("id", "both")) %>%
na.omit() %>%
filter(
age != "Total",
!grepl("De", age),
!grepl("85 años", age)
) %>%
mutate(age = str_extract(age,"\\d+"))
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))Data
La función gather()nos ayudará a transformar las columnas male y female en filas, creando nuevas columnas sex y pob. Por otro lado type_convert()se utiliza para convertir automáticamente las columnas de un data frame a los tipos de datos más apropiados según su contenido. En nuestro caso, la variable age pasará de string a numeric
library(tidyverse)
library(stringr)
library(DT)
load("R/data.RData")
names(data)<-
c("id","edo","age","both","males","females")
base_mx <- data %>%
filter(is.na(edo) == FALSE) %>%
select(-c("id", "both")) %>%
na.omit() %>%
filter(
age != "Total",
!grepl("De", age),
!grepl("85 años", age)
) %>%
mutate(age = str_extract(age,"\\d+")) %>%
gather(key = sex, value = pob, -age, -edo) %>%
type_convert()
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))Data
Usaremos la función mutate() para crear una nueva columan pop2. Si sex toma el valor de female entonces pop2 tomará el valor de pop; en otro caso, pop2 tomará el valor de -pop Finalmente guardaremos nuestra nueva tabla de datos base_mx en nuestra carpeta output
library(tidyverse)
library(stringr)
library(DT)
load("R/data.RData")
names(data)<-
c("id","edo","age","both","males","females")
base_mx <- data %>%
filter(is.na(edo) == FALSE) %>%
select(-c("id", "both")) %>%
na.omit() %>%
filter(
age != "Total",
!grepl("De", age),
!grepl("85 años", age)
) %>%
mutate(age = str_extract(age,"\\d+")) %>%
gather(key = sex, value = pob, -age, -edo) %>%
type_convert() %>%
mutate(pob2 = ifelse(sex == "females", pob, -pob))
save(base_mx, file = "input/base_mx.RData")
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))Base_mx
Para la gráfica de la piramide de población, tomaremos en cuenta la población total. Para esta labor, recordemos que deberemos omitir los valores NA.
Base_mx
Base_mx
Base_mx
library(tidyverse)
base_mx %>%
filter(edo == "Total", is.na(age) == FALSE) %>%
ggplot() +
geom_bar(aes(x = age, y = pob2/1000000, fill = age),
stat = "identity",
show.legend = F) +
coord_flip() +
geom_hline(yintercept = 0) +
scale_y_continuous(
limits = c(-1.25, 1.25),
breaks = seq(-1.25, 1.25, 0.25),
labels = as.character(
c(seq(1.25, 0, -0.25),seq(0.25, 1.25, 0.25)
))
)Base_mx
library(tidyverse)
base_mx %>%
filter(edo == "Total", is.na(age) == FALSE) %>%
ggplot() +
geom_bar(aes(x = age, y = pob2/1000000, fill = age),
stat = "identity",
show.legend = F) +
coord_flip() +
geom_hline(yintercept = 0) +
scale_y_continuous(
limits = c(-1.25, 1.25),
breaks = seq(-1.25, 1.25, 0.25),
labels = as.character(
c(seq(1.25, 0, -0.25),seq(0.25, 1.25, 0.25)
))
)+
scale_x_continuous(
limits = c(-1, 101), breaks = seq(0, 100, 5),
labels = seq(0, 100, 5)
)Base_mx
library(tidyverse)
base_mx %>%
filter(edo == "Total", is.na(age) == FALSE) %>%
ggplot() +
geom_bar(aes(x = age, y = pob2/1000000, fill = age),
stat = "identity",
show.legend = F) +
coord_flip() +
geom_hline(yintercept = 0) +
scale_y_continuous(
limits = c(-1.25, 1.25),
breaks = seq(-1.25, 1.25, 0.25),
labels = as.character(
c(seq(1.25, 0, -0.25),seq(0.25, 1.25, 0.25)
))
)+
scale_x_continuous(
limits = c(-1, 101), breaks = seq(0, 100, 5),
labels = seq(0, 100, 5)
)+
annotate(
geom = "text", x = 95, y = -1, label = "Hombres",
color = "black", size = 3
) +
annotate(
geom = "text", x = 95, y = 1, label = "Mujeres",
color = "black", size = 3
) Base_mx
library(tidyverse)
base_mx %>%
filter(edo == "Total", is.na(age) == FALSE) %>%
ggplot() +
geom_bar(aes(x = age, y = pob2/1000000, fill = age),
stat = "identity",
show.legend = F) +
coord_flip() +
geom_hline(yintercept = 0) +
scale_y_continuous(
limits = c(-1.25, 1.25),
breaks = seq(-1.25, 1.25, 0.25),
labels = as.character(
c(seq(1.25, 0, -0.25),
seq(0.25, 1.25, 0.25)
))
) +
scale_x_continuous(
limits = c(-1, 101), breaks = seq(0, 100, 5),
labels = seq(0, 100, 5)
)+
annotate(
geom = "text", x = 95, y = -1, label = "Hombres",
color = "black", size = 3
) +
annotate(
geom = "text", x = 95, y = 1, label = "Mujeres",
color = "black", size = 3
) +
theme_light()Base_mx
library(tidyverse)
base_mx %>%
filter(edo == "Total", is.na(age) == FALSE) %>%
ggplot() +
geom_bar(aes(x = age, y = pob2/1000000, fill = age),
stat = "identity",
show.legend = F) +
coord_flip() +
geom_hline(yintercept = 0) +
scale_y_continuous(
limits = c(-1.25, 1.25),
breaks = seq(-1.25, 1.25, 0.25),
labels = as.character(
c(seq(1.25, 0, -0.25),
seq(0.25, 1.25, 0.25)
))
) +
scale_x_continuous(
limits = c(-1, 101), breaks = seq(0, 100, 5),
labels = seq(0, 100, 5)
)+
annotate(
geom = "text", x = 95, y = -1, label = "Hombres",
color = "black", size = 3
) +
annotate(
geom = "text", x = 95, y = 1, label = "Mujeres",
color = "black", size = 3
) +
theme_light() +
scale_fill_viridis_c(option = "A", guide = guide_colorbar())+
labs(y = "Población (millones)", x = "Edad", fill = "Edad")Escoja algún estado de la tabla de datos base_mx y determine su pirámide de población.
Calcule la proporción de gente no especificada de población total para ambos sexos, hombres y mujeres.
Para esto, use un left_join para unir dos tablas.
La tabla izquierda deberá contar con la población total pob para ambos sexos.
La tabla derecha deberá contar con la población total no especificada pob_na para ambos sexos.
Calcule la proporción rat de la poblacion total no especificada en porcentaje.
library(tidyverse)
library(DT)
load("input/base_mx.RData")
base_mx <- left_join(
base_mx %>%
filter(edo == "Total", is.na(age) == F) %>%
group_by(sex) %>%
summarise(pob = sum(pob), .groups = "drop"),
base_mx %>%
filter(edo== "Total", is.na(age) == T) %>%
select(sex, pob_na = pob),
by = "sex") %>%
mutate(rat = 100 * pob_na / pob)
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))base_mx
Tabla izquierda
base_mx
base_mx
base_mx
base_mx
Tabla derecha
library(tidyverse)
library(DT)
tabla_izq <- base_mx %>%
filter(edo == "Total") %>%
group_by(sex) %>%
mutate(prop = pob / sum(pob)) %>%
filter(is.na(age) == F) %>%
ungroup()
tabla_der <- base_mx %>%
filter(edo == "Total", is.na(age) == T)
datatable(tabla_der, options = list(scrollX = TRUE, scrollY = "500px"))base_mx
library(tidyverse)
library(DT)
tabla_izq <- base_mx %>%
filter(edo == "Total") %>%
group_by(sex) %>%
mutate(prop = pob / sum(pob)) %>%
filter(is.na(age) == F) %>%
ungroup()
tabla_der <- base_mx %>%
filter(edo == "Total", is.na(age) == T) %>%
select(sex, pob_na = pob)
datatable(tabla_der, options = list(scrollX = TRUE, scrollY = "500px"))base_mx
Tabla de datos prorateada base_mx_pror
library(tidyverse)
library(DT)
tabla_izq <- base_mx %>%
filter(edo == "Total") %>%
group_by(sex) %>%
mutate(prop = pob / sum(pob)) %>%
filter(is.na(age) == F) %>%
ungroup()
tabla_der <- base_mx %>%
filter(edo == "Total", is.na(age) == T) %>%
select(sex, pob_na = pob)
base_mx_pror <- left_join(tabla_izq,tabla_der,by = "sex")
datatable(base_mx_pror, options = list(scrollX = TRUE, scrollY = "500px"))base_mx
Recordemos la formula para la población final, \(N^*_x\), para la variable pop_fin.
library(tidyverse)
library(DT)
tabla_izq <- base_mx %>%
filter(edo == "Total") %>%
group_by(sex) %>%
mutate(prop = pob / sum(pob)) %>%
filter(is.na(age) == F) %>%
ungroup()
tabla_der <- base_mx %>%
filter(edo == "Total", is.na(age) == T) %>%
select(sex, pob_na = pob)
base_mx_pror <- left_join(tabla_izq,tabla_der,by = "sex")
base_mx_pror <- base_mx_pror %>%
mutate(pob_fin = pob + pob_na * prop)
datatable(base_mx_pror, options = list(scrollX = TRUE, scrollY = "500px"))\(N^*_x = N_x + N_{ne} \frac{N_x}{\sum_{x=0}^w N_x}\)
base_mx
Resultado final para la tabla de datos base_mx_pror
library(tidyverse)
library(DT)
tabla_izq <- base_mx %>%
filter(edo == "Total") %>%
group_by(sex) %>%
mutate(prop = pob / sum(pob)) %>%
filter(is.na(age) == F) %>%
ungroup()
tabla_der <- base_mx %>%
filter(edo == "Total", is.na(age) == T) %>%
select(sex, pob_na = pob)
base_mx_pror <- left_join(tabla_izq,tabla_der,by = "sex")
base_mx_pror <- base_mx_pror %>%
mutate(pob_fin = pob + pob_na * prop) %>%
select(age, sex, pob = pob_fin)
datatable(base_mx_pror, options = list(scrollX = TRUE, scrollY = "500px"))